home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / TECHNICA / AUTOCAD / H108.ZIP / JUL91.ZIP / SIPIPE.LSP < prev    next >
Text File  |  1991-09-26  |  7KB  |  253 lines
  1. ;SIPIPE.LSP   [Article Figure 3]   (c)1991, Barry Bowen
  2.  
  3. ;--------------------------------------------------------------
  4. ; VARIABLES:
  5. ; ANG1  = Reset angle from PT1 to PT2
  6. ; ANG2  = Angle from the second line PT1 to PT2
  7. ; ANG3  = Angle from the first line PT1 to PT2
  8. ; ANG3A = Angle from the first line PT2 to PT1
  9. ; BANG  = Break angle for ELUP fitting
  10. ; BM    = Current blipmode setting
  11. ; BPT   = Break point for ELUP fitting
  12. ; CL    = Current layer name
  13. ; COLR  = New layer color [Global]
  14. ; DIST  = Distance from PTA to PTB
  15. ; FIT   = Pipe fitting type
  16. ; FRZ   = Variable for frozen layer check
  17. ; LAY   = Variable for layer name check
  18. ; LIN   = Last line drawn
  19. ; LT    = Variable used for checking Linetype
  20. ; LTYP  = Linetype for new layer [Global]
  21. ; NWLAY = New layer name [Global]
  22. ; PTA   = Point on first line for locating fitting insertion
  23. ; PTB   = Point on second line for locating fitting insertion
  24. ; PTC   = Fitting insertion point
  25. ; PT1   = Pipe line begin point [Reset to PT2]
  26. ; PT2   = Pipe line ending point [Reset to PT1]
  27. ; SF    = Linetype scale factor
  28. ; TANG  = Test angle for EL90 and EL45 fittings
  29. ; VLIST = Current environment variables list
  30. ;--------------------------------------------------------------
  31.  
  32. (defun C:SLPIPE (/ ANG1 ANG2 ANG3 ANG3A BANG BM BPT CL DIST FIT
  33.                    FRZ LAY LIN PTA PTB PTC PT1 PT2 TANG VLIST)
  34.    (V3)
  35.    (V1 '("osmode" "orthomode"))
  36.    (setvar "orthomode" 1)
  37.    (setvar "osmode" 0)
  38.    (if (= NWLAY nil) (NEWLAY))
  39.    (LS NWLAY COLR LTYP)
  40.    (if (= SF nil) (setq SF (getvar "ltscale")))
  41.    (FITTING)
  42.    (setq
  43.       PT1 (getpoint "\nPipe Begin Point: ")
  44.       PT2 (getpoint PT1 "\nNext point: ")
  45.       ANG2 (angle PT1 PT2)
  46.       ANG3 ANG2
  47.       ANG3A (angle PT2 PT1)
  48.       PTA (polar PT2 ANG3A 1)
  49.    )
  50.    (if (= FIT "TEE") (setq ANG3 (+ ANG3 pi)))
  51.    (setq
  52.       ANG3 (angtos ANG3 1 4)
  53.       ANG1 (angle PT1 PT2)
  54.    )
  55.    (if (/= FIT "NONE") (command ".insert" FIT PT1 SF SF ANG3))
  56.    (if (= FIT "ELUP") (setq PT1 (polar PT1 ANG1 (* SF 0.02))))
  57.    (command ".line" PT1 PT2 "")
  58.    (setq
  59.       PT1 PT2
  60.       LIN (entlast)
  61.    )
  62.    (while PT2
  63.       (setq PT2 (getpoint PT1 "\nNext Point: "))
  64.       (if (/= PT2 nil)
  65.          (progn
  66.             (setq
  67.                ANG2 (angle PT1 PT2)
  68.                ANG3 (angle PT2 PT1)
  69.                PTB (polar PT1 ANG2 1)
  70.                TANG (angle PTA PTB)
  71.                DIST (distance PTA PTB)
  72.                PTC (polar PTA TANG (/ DIST 2.0))
  73.             )
  74.             (cond
  75.                ((= TANG (D45)) (setq FIT "EL90"))
  76.                ((= TANG (D135)) (setq FIT "EL90"))
  77.                ((= TANG (D225)) (setq FIT "EL90"))
  78.                ((= TANG (D315)) (setq FIT "EL90"))
  79.                (T (setq FIT "EL45"))
  80.             )
  81.             (command
  82.                ".insert" FIT PT1 SF SF PTC
  83.                ".line" PT1 PT2 ""
  84.             )
  85.             (setq
  86.                LIN (entlast)
  87.                PT1 PT2
  88.                ANG1 ANG2
  89.                PTA (polar PT1 ANG3 1)
  90.             )
  91.          )
  92.          (progn
  93.             (FITTING)
  94.             (if (/= FIT "TEE") (setq ANG1 (+ ANG1 pi)))
  95.             (setq ANG1 (angtos ANG1 1 4))
  96.             (command ".insert" FIT PT1 SF SF ANG1)
  97.          )
  98.       )
  99.    )
  100.    (setq
  101.       BANG (+ ANG2 pi)
  102.       BPT (polar PT1 BANG (* SF 0.02))
  103.    )
  104.    (if (= FIT "ELUP") (command ".break" LIN PT1 BPT))
  105.    (RL)
  106.    (V1R)
  107.    (V4)
  108. )
  109.  
  110. ;----------------------- FITTING ----------------------------
  111. ; Pipe fittings (blocks) for SLPIPE program
  112. ;
  113. (defun FITTING ()
  114.    (initget 1 "U D T C B N")
  115.    (setq FIT
  116.       (getkword "\n<U>p/<D>own/<T>ee/<C>ap/<B>rk/<N>one: ")
  117.    )
  118.    (cond
  119.       ((= FIT "U") (setq FIT "ELUP"))
  120.       ((= FIT "D") (setq FIT "ELDN"))
  121.       ((= FIT "T") (setq FIT "TEE"))
  122.       ((= FIT "C") (setq FIT "CAP"))
  123.       ((= FIT "B") (setq FIT "BRK"))
  124.       ((= FIT "N") (setq FIT "NONE"))
  125.    )
  126. )
  127.  
  128. ;-------------------- Routines For Angles -------------------
  129. ;
  130. (defun D45 () (* pi 0.25))
  131. (defun D90 () (* pi 0.5))
  132. (defun D135 () (* pi 0.75))
  133. (defun D225 () (* pi 1.25))
  134. (defun D270 () (* pi 1.5))
  135. (defun D315 () (* pi 1.75))
  136. (defun A180 () (+ ANG pi))
  137.  
  138. ;------------------------- V1.LSP ---------------------------
  139. ; Change environment variables
  140. ;
  141. (defun V1 (SV)
  142.    (setq VLIST '())
  143.    (while SV
  144.       (setq
  145.          VLIST (append VLIST
  146.                   (list (list (car SV) (getvar (car SV))))
  147.                )
  148.          SV (cdr SV)
  149.       )
  150.    )
  151. )
  152.  
  153. ;------------------------- V1R.LSP --------------------------
  154. ; Reset environment variables changed by "V1"
  155. ;
  156. (defun V1R ()
  157.    (while VLIST
  158.       (setvar (caar VLIST) (cadar VLIST))
  159.       (setq VLIST (cdr VLIST))
  160.    )
  161. )
  162.  
  163. ;------------------------- V3.LSP ---------------------------
  164. ; Start-up routine
  165. ;
  166. (defun V3 ()
  167.    (setq BM (getvar "blipmode"))
  168.    (setvar "blipmode" 0)
  169.    (setvar "cmdecho" 0)
  170.    (command ".undo" "group")
  171. )
  172.  
  173. ;------------------------- V4.LSP ---------------------------
  174. ; Ending routine
  175. ;
  176. (defun V4 (/ BA)
  177.    (setvar "blipmode" BM)
  178.    (command ".undo" "end")
  179.    (prompt "\n")
  180.    (setq BA "Program Completed. . . . .")
  181. )
  182.  
  183. ;------------------------ NEWLAY ----------------------------
  184. ; Used with "LS" for creating new Layer/Color/Linetype
  185. ;
  186. (defun NEWLAY ()
  187.    (setq
  188.       NWLAY (getstring "\nNew Layer Name: ")
  189.       COLR (getstring "\nColor Number <7>: ")
  190.       LTYP (getstring "\nLinetype <Continuous>: ")
  191.    )
  192.    (if (= LTYP "") (setq LT "continuous") (setq LT LTYP))
  193.    (while (= (tblsearch "LTYPE" LT) nil)
  194.       (prompt (strcat "\nLinetype " LT " not found!"))
  195.       (setq LTYP (getstring "\nLinetype <Continuous>: "))
  196.       (if (= LTYP "") (setq LT "continuous") (setq LT LTYP))
  197.    )
  198.    (if (= LTYP "") (setq LTYP ""))
  199.    (if (= COLR "") (setq COLR "7"))
  200. )
  201.  
  202. ;--------------------------- LS -----------------------------
  203. ; Creates new layer with color and linetype from "NEWLAY"
  204. ;
  205. (defun LS (NLAY CLR LT)
  206.    (setq
  207.       CL  (getvar "clayer")
  208.       LAY (tblsearch "layer" NLAY)
  209.    )
  210.    (if (not LAY)
  211.       (command ".layer" "m" NLAY "c" CLR "" "lt" LT "" "")
  212.       (progn
  213.          (setq FRZ (cdr (assoc 70 LAY)))
  214.          (if (= FRZ 65)
  215.             (command ".layer" "t" NLAY "s" NLAY "")
  216.             (command ".layer" "s" NLAY "")
  217.          )
  218.       )
  219.    )
  220. )
  221.  
  222. ;--------------------------- RL -----------------------------
  223. ; Resets the previous layer to the current layer.
  224. ;
  225. (defun RL ()
  226.    (command ".layer" "s" CL "")
  227. )
  228.  
  229. ;------------------------- *ERROR* --------------------------
  230. ; Error routine
  231. (defun *error* (MSG)
  232.    (princ "error: ")
  233.    (princ MSG)
  234.    (RL)
  235.    (V1R)
  236.    (V4)
  237. )
  238.  
  239. (prompt "\nSingle Line Piping Program SLPIPE is Now Loaded!")
  240. (princ)
  241. 
  242.  
  243.  
  244.  
  245.  
  246.  
  247.  
  248.  
  249.  
  250.  
  251.  
  252.  
  253.